The CDPD Public Domain Collection for CDTV 3/CDPDIII.bin/pd/amigamagazin/02-93b/devices (folge 4)/condev0.mod

Text File | 1992-05-09 | 6KB | 272 lines

MODULE ConDev0;

FROM Arts IMPORT
    BreakPoint, kickVersion;(* Var m. Vers Nr des Betriebssystems *)
FROM Console IMPORT
    consoleName;
FROM ConUnit IMPORT
    conuCharmap, conuSnipmap, conuStandard;    (* OS 2 *)
FROM DosL IMPORT
    Delay;
FROM ExecD IMPORT
    IOStdReq, IOStdReqPtr, MsgPortPtr, read, write;
FROM ExecL IMPORT
    AbortIO, CheckIO, CloseDevice, CreateIORequest, CreateMsgPort,
    DeleteIORequest, DeleteMsgPort, DoIO, GetMsg,
    OpenDevice, ReplyMsg, SendIO, WaitIO, WaitPort;
FROM IntuitionD IMPORT
        IDCMPFlags, IDCMPFlagSet, WaTags, Window, WindowFlags,
        WindowFlagSet, WindowPtr;
FROM IntuitionL IMPORT
    CloseWindow, ModifyIDCMP, OpenWindowTagList;
FROM UtilityD IMPORT
    tagDone;
FROM SYSTEM IMPORT
    ADR, ADDRESS, CAST, LONGSET, TAG;
FROM Terminal IMPORT
    WriteString;

CONST OS200 = 36;                 (* mindestens OS 2.0 *)
      ConFlagDefault = LONGSET{};
   (*
      ConFlagNoDrawOnNewSize = 1;
   *)
VAR
  ourWinPtr   : WindowPtr;
  conWritePtr,
  conReadPtr  : IOStdReqPtr;


PROCEDURE IORequestAbbauen(VAR reqPtr : IOStdReqPtr);

BEGIN
  IF reqPtr^.message.replyPort # NIL THEN
     DeleteMsgPort(reqPtr^.message.replyPort);
  END;
  DeleteIORequest(reqPtr); (* OS 2 *)
END IORequestAbbauen;


PROCEDURE Aufraeumen;

BEGIN
  IF conReadPtr # NIL THEN
    IF ~ CheckIO(conReadPtr) THEN
      AbortIO(conReadPtr);
      WaitIO(conReadPtr);
    END;
    IORequestAbbauen(conReadPtr);
  END;

  IF conWritePtr # NIL THEN
    IF conWritePtr^.device # NIL THEN
      CloseDevice(conWritePtr);
    END;
    IORequestAbbauen(conWritePtr);
  END;

  IF ourWinPtr # NIL THEN
    CloseWindow(ourWinPtr);
  END;
END Aufraeumen;


PROCEDURE FensterAngelegt(VAR win : WindowPtr):BOOLEAN;

VAR  tagBuffer : ARRAY[0..19] OF LONGINT;

BEGIN
   win := OpenWindowTagList             (* OS 2 *)
            (NIL, TAG(tagBuffer,
                    waLeft,      20,
                    waTop,       20,
                    waTitle,    ADR(" Con Dev 0 "),
                    waWidth,    500,
                    waHeight,   200,
                    waMinWidth, 100,
                    waMinHeight, 50,
                    waFlags,  WindowFlagSet{simpleRefresh,
                                            windowClose,
                                            windowDepth,
                                            windowDrag,
                                            windowSizing},
                  tagDone));
  RETURN (win # NIL);
END FensterAngelegt;


PROCEDURE IORequestAngelegt(VAR conPtr : IOStdReqPtr):BOOLEAN;

VAR portPtr : MsgPortPtr;
    done    : BOOLEAN;

BEGIN
  done := FALSE;
  portPtr := CreateMsgPort(); (* OS2 *)
  IF portPtr # NIL THEN
    conPtr := CreateIORequest(portPtr, SIZE(conPtr^)); (* OS 2*)
    IF conPtr # NIL THEN
      done := TRUE;
    ELSE
      DeleteMsgPort(portPtr);
    END;
  END;
  RETURN done;
END IORequestAngelegt;


PROCEDURE ConsoleEingerichtet(VAR wrPtr,
                                  rdPtr : IOStdReqPtr;
                                  winPtr : WindowPtr) : BOOLEAN;
VAR done : BOOLEAN;

BEGIN
  done := FALSE;
  IF IORequestAngelegt(wrPtr) THEN
    wrPtr^.data := winPtr;
    wrPtr^.length := SIZE(winPtr^);
    OpenDevice(ADR(consoleName), conuStandard,
                 wrPtr, ConFlagDefault);
    IF (wrPtr^.error = 0) AND IORequestAngelegt(rdPtr) THEN
      rdPtr^.unit := wrPtr^.unit;
      rdPtr^.device := wrPtr^.device;
      done := TRUE;
    ELSE
      Aufraeumen;
    END;
  END;
  RETURN done;
END ConsoleEingerichtet;


PROCEDURE ConWriteStr(conPtr : IOStdReqPtr;
                      str    : ADDRESS);
BEGIN
  conPtr^.data := str;
  conPtr^.length := -1;
  conPtr^.command := write;
  DoIO(conPtr);
END ConWriteStr;


PROCEDURE ConWriteBuf(conPtr : IOStdReqPtr;
                      bufPtr     : ADDRESS;
                      laenge     : INTEGER);
BEGIN
  conPtr^.data := bufPtr;
  conPtr^.length := laenge;
  conPtr^.command := write;
  DoIO(conPtr);
END ConWriteBuf;


PROCEDURE ConReadSync(conPtr : IOStdReqPtr;
                  bufPtr : ADDRESS;
                  laenge : INTEGER) : INTEGER;
BEGIN
  conPtr^.data := bufPtr;
  conPtr^.length := laenge;
  conPtr^.command := read;
  SendIO(conPtr);
  WaitIO(conPtr);
  RETURN conPtr^.actual;
END ConReadSync;


PROCEDURE SchreibTest;

VAR zaehler : INTEGER;

BEGIN
  ConWriteStr(conWritePtr,
              ADR("\033[1;31mHallo Console! "));
(*                 ^   ^^ ^ ^
                   |   || | 0x6D = Terminator
                   |   || rot
                   |   |bold
                   |   0x5B \
                   ESC      / Ersatz fuer CSI
*)
  FOR zaehler := 0 TO 99 DO
    ConWriteStr(conWritePtr, (* bold + Farbe bleibt *)
                ADR("Hallo Console! "));
  END;
END SchreibTest;


PROCEDURE LeseTest;

VAR buffer : ARRAY[0..9] OF CHAR;
    laenge : INTEGER;

BEGIN
  ConWriteStr(conWritePtr,
            ADR("\n\033[3;32m** Geben Sie 1 Zeichen ein ** "));
(*                  ^  ^^ ^ ^
                    |  || | 0x6D = Terminator
                    |  || gruen
                    |  |italic
                    |  0x5B
                    ESC
*)
  laenge := ConReadSync(conReadPtr, ADR(buffer), SIZE(buffer));
  IF buffer[0] = 233C THEN
    buffer[0] := "@"
  END;
  ConWriteBuf(conWritePtr, ADR(buffer), laenge);
END LeseTest;


PROCEDURE LeseRawEvent;

VAR buffer : ARRAY[0..999] OF CHAR;
    index,
    laenge : INTEGER;

BEGIN

  ConWriteStr(conWritePtr,
  ADR("\033[0;31m\n\n\033[1{cl;scl;key;qual;x;y;sec;mic|\n"));

  Delay(100);

  laenge := ConReadSync(conReadPtr, ADR(buffer), SIZE(buffer));

  FOR index := 0 TO (laenge - 1) DO
    IF buffer[index] = 233C THEN
      buffer[index] := 012C;
    END;
  END;
  ConWriteBuf(conWritePtr, ADR(buffer), laenge);
END LeseRawEvent;


PROCEDURE IDCMPCloseClickAbholen(winPtr : WindowPtr);

BEGIN
  ModifyIDCMP(winPtr, IDCMPFlagSet{closeWindow});
  WaitPort(winPtr^.userPort);
  ReplyMsg(GetMsg(winPtr^.userPort));
END IDCMPCloseClickAbholen;


BEGIN
  IF kickVersion >= OS200 THEN
    IF FensterAngelegt(ourWinPtr) THEN
      IF ConsoleEingerichtet(conWritePtr, conReadPtr, ourWinPtr) THEN

        SchreibTest;
        LeseTest;
        LeseRawEvent;

        IDCMPCloseClickAbholen(ourWinPtr);

        Aufraeumen;
      END;
    END;
  ELSE
    WriteString("Programm setzt OS 2 voraus\n");
  END;
END ConDev0.